home *** CD-ROM | disk | FTP | other *** search
/ PC Open 107 / PC Open 107 CD 1.bin / CD1 / INTERNET / EMAIL / pop file / setup.exe / $_1_ / IO / Socket / Socks.pm < prev    next >
Encoding:
Perl POD Document  |  2003-07-15  |  35.2 KB  |  1,173 lines
  1. ##############################################################################
  2. #
  3. #  This library is free software; you can redistribute it and/or
  4. #  modify it under the terms of the GNU Library General Public
  5. #  License as published by the Free Software Foundation; either
  6. #  version 2 of the License, or (at your option) any later version.
  7. #
  8. #  This library is distributed in the hope that it will be useful,
  9. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  10. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  11. #  Library General Public License for more details.
  12. #
  13. #  You should have received a copy of the GNU Library General Public
  14. #  License along with this library; if not, write to the
  15. #  Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  16. #  Boston, MA  02111-1307, USA.
  17. #
  18. #  Copyright (C) 2003 Ryan Eatmon
  19. #
  20. ##############################################################################
  21. package IO::Socket::Socks;
  22.  
  23. =head1 NAME
  24.  
  25. IO::Socket::Socks
  26.  
  27. =head1 SYNOPSIS
  28.  
  29. Provides a way to open a connection to a SOCKS v5 proxy and use the object
  30. just like an IO::Socket.
  31.  
  32. =head1 DESCRIPTION
  33.  
  34. IO::Socket::Socks connects to a SOCKS v5 proxy, tells it to open a
  35. connection to a remote host/port when the object is created.  The
  36. object you receive can be used directly as a socket for sending and
  37. receiving data from the remote host.
  38.  
  39. =head1 EXAMPLES
  40.  
  41. =head2 Client
  42.  
  43. use IO::Socket::Socks;
  44.  
  45. my $socks = new IO::Socket::Socks(ProxyAddr=>"proxy host",
  46.                                   ProxyPort=>"proxy port",
  47.                                   ConnectAddr=>"remote host",
  48.                                   ConnectPort=>"remote port",
  49.                                  );
  50.  
  51. print $socks "foo\n";
  52.  
  53. $socks->close();
  54.  
  55. =head2 Server
  56.  
  57. use IO::Socket::Socks;
  58.  
  59. my $socks_server = new IO::Socket::Socks(ProxyAddr=>"localhost",
  60.                                          ProxyPort=>"8000",
  61.                                          Listen=>1,
  62.                                          UserAuth=>\&auth,
  63.                                          RequireAuth=>1
  64.                                         );
  65.  
  66. my $select = new IO::Select($socks_server);
  67.         
  68. while(1)
  69. {
  70.     if ($select->can_read())
  71.     {
  72.         my $client = $socks_server->accept();
  73.  
  74.         if (!defined($client))
  75.         {
  76.             print "ERROR: $SOCKS_ERROR\n";
  77.             next;
  78.         }
  79.  
  80.         my $command = $client->command();
  81.         if ($command->[0] == 1)  # CONNECT
  82.         {
  83.             # Handle the CONNECT
  84.             $client->command_reply(0, addr, port);
  85.         }
  86.         
  87.         ...
  88.         #read from the client and send to the CONNECT address
  89.         ...
  90.  
  91.         $client->close();
  92.     }
  93. }
  94.         
  95.  
  96. sub auth
  97. {
  98.     my $user = shift;
  99.     my $pass = shift;
  100.  
  101.     return 1 if (($user eq "foo") && ($pass eq "bar"));
  102.     return 0;
  103. }
  104.  
  105.  
  106. =head1 METHODS
  107.  
  108. =head2 new( %cfg )
  109.  
  110. Creates a new IO::Socket::Socks object.  It takes the following
  111. config hash:
  112.  
  113.   ProxyAddr => Hostname of the proxy
  114.  
  115.   ProxyPort => Port of the proxy
  116.   
  117.   ConnectAddr => Hostname of the remote machine
  118.  
  119.   ConnectPort => Port of the remote machine
  120.  
  121.   AuthType => What kind of authentication to support:
  122.                 none       - no authentication (default)
  123.                 userpass  - Username/Password
  124.  
  125.   RequireAuth => Do not send, or accept, ANON as a valid
  126.                  auth mechanism.
  127.  
  128.   UserAuth => Function that takes ($user,$pass) and returns
  129.               1 if they are allowed, 0 otherwise.
  130.  
  131.   Username => If AuthType is set to userpass, then you must
  132.               provide a username.
  133.  
  134.   Password => If AuthType is set to userpass, then you must
  135.               provide a password.
  136.               
  137.   SocksDebug => This will cause all of the SOCKS traffic to
  138.                 be presented on the command line in a form
  139.                 similar to the tables in the RFCs.
  140.  
  141.   Listen => 0 or 1.  Listen on the ProxyAddr and ProxyPort
  142.             for incoming connections.
  143.  
  144. =head2 accept( )
  145.  
  146. Accept an incoming connection and return a new IO::Socket::Socks
  147. object that represents that connection.  You must call command()
  148. on this to find out what the incoming connection wants you to do,
  149. and then call command_reply() to send back the reply.
  150.  
  151. =head2 command( )
  152.  
  153. After you call accept() the client has sent the command they want
  154. you to process.  This function returns a reference to an array with
  155. the following format:
  156.  
  157.   [ COMMAND, HOST, PORT ]
  158.  
  159. =head2 command_reply( REPLY CODE, HOST, PORT )
  160.  
  161. After you call command() the client needs to be told what the result
  162. is.  The REPLY CODE is as follows (integer value):
  163.  
  164.   0: Success
  165.   1: General Failure
  166.   2: Connection Not Allowed
  167.   3: Network Unreachable
  168.   4: Host Unreachable
  169.   5: Connection Refused
  170.   6: TTL Expired
  171.   7: Command Not Supported
  172.   8: Address Not Supported
  173.  
  174. HOST and PORT are the resulting host and port that you use for the
  175. command.
  176.  
  177. =head1 VARIABLES
  178.  
  179. =head2 $SOCKS_ERROR
  180.  
  181. This scalar behaves like $! in that if undef is returned, this variable
  182. should contain a string reason for the error.
  183.  
  184. =head1 AUTHOR
  185.  
  186. Ryan Eatmon
  187.  
  188. =head1 COPYRIGHT
  189.  
  190. This module is free software, you can redistribute it and/or modify
  191. it under the same terms as Perl itself.
  192.  
  193. =cut
  194.  
  195. #XXX document socks5 rfcs
  196. #XXX document SOCKS_ERROR
  197.  
  198. use strict;
  199. use IO::Socket;
  200. use Carp;
  201. use base qw( IO::Socket::INET );
  202. use vars qw(@ISA @EXPORT $VERSION %CODES );
  203. require Exporter;
  204. @ISA = qw(Exporter IO::Socket::INET);
  205. @EXPORT = qw( $SOCKS_ERROR );
  206.  
  207. $VERSION = "0.1";
  208. our $SOCKS_ERROR;
  209.  
  210. use constant SOCKS5_VER =>  5;
  211.  
  212. use constant ADDR_IPV4       => 1;
  213. use constant ADDR_DOMAINNAME => 3;
  214. use constant ADDR_IPV6       => 4;
  215.  
  216. use constant CMD_CONNECT  => 1;
  217. #use constant CMD_BIND     => 2;
  218. #use constant CMD_UDPASSOC => 3;
  219.  
  220. use constant AUTHMECH_ANON     => 0;
  221. #use constant AUTHMECH_GSSAPI   => 1;
  222. use constant AUTHMECH_USERPASS => 2;
  223. use constant AUTHMECH_INVALID  => 255;
  224.  
  225. $CODES{AUTHMECH}->[AUTHMECH_INVALID] = "No valid auth mechanisms";
  226.  
  227. use constant AUTHREPLY_SUCCESS  => 0;
  228. use constant AUTHREPLY_FAILURE  => 1;
  229.  
  230. $CODES{AUTHREPLY}->[AUTHREPLY_FAILURE] = "Failed to authenticate";
  231.  
  232. use constant REPLY_SUCCESS             => 0;
  233. use constant REPLY_GENERAL_FAILURE     => 1;
  234. use constant REPLY_CONN_NOT_ALLOWED    => 2;
  235. use constant REPLY_NETWORK_UNREACHABLE => 3;
  236. use constant REPLY_HOST_UNREACHABLE    => 4;
  237. use constant REPLY_CONN_REFUSED        => 5;
  238. use constant REPLY_TTL_EXPIRED         => 6;
  239. use constant REPLY_CMD_NOT_SUPPORTED   => 7;
  240. use constant REPLY_ADDR_NOT_SUPPORTED  => 8;
  241.  
  242. $CODES{REPLY}->[REPLY_SUCCESS] = "Success";
  243. $CODES{REPLY}->[REPLY_GENERAL_FAILURE] = "General failure";
  244. $CODES{REPLY}->[REPLY_CONN_NOT_ALLOWED] = "Not allowed";
  245. $CODES{REPLY}->[REPLY_NETWORK_UNREACHABLE] = "Network unreachable";
  246. $CODES{REPLY}->[REPLY_HOST_UNREACHABLE] = "Host unreachable";
  247. $CODES{REPLY}->[REPLY_CONN_REFUSED] = "Connection refused";
  248. $CODES{REPLY}->[REPLY_TTL_EXPIRED] = "TTL expired";
  249. $CODES{REPLY}->[REPLY_CMD_NOT_SUPPORTED] = "Command not supported";
  250. $CODES{REPLY}->[REPLY_ADDR_NOT_SUPPORTED] = "Address not supported";
  251.  
  252.  
  253. #------------------------------------------------------------------------------
  254. # sub new is handled by IO::Socket::INET
  255. #------------------------------------------------------------------------------
  256.  
  257. ###############################################################################
  258. #
  259. # configure - read in the config hash and populate the object.
  260. #
  261. ###############################################################################
  262. sub configure
  263. {
  264.     my $self = shift;
  265.     my $args = shift;
  266.  
  267.     ${*$self}->{SOCKS}->{ProxyAddr} =
  268.         (exists($args->{ProxyAddr}) ?
  269.          delete($args->{ProxyAddr}) :
  270.          croak("You must provide a ProxyAddr to either connect to, or listen on.")
  271.         );
  272.  
  273.     ${*$self}->{SOCKS}->{ProxyPort} =
  274.         (exists($args->{ProxyPort}) ?
  275.          delete($args->{ProxyPort}) :
  276.          croak("You must provide a ProxyPort to either connect to, or listen on.")
  277.         );
  278.  
  279.     ${*$self}->{SOCKS}->{ConnectAddr} =
  280.         (exists($args->{ConnectAddr}) ?
  281.          delete($args->{ConnectAddr}) :
  282.          undef
  283.         );
  284.  
  285.     ${*$self}->{SOCKS}->{ConnectPort} =
  286.         (exists($args->{ConnectPort}) ?
  287.          delete($args->{ConnectPort}) :
  288.          undef
  289.         );
  290.     
  291.     #${*$self}->{SOCKS}->{BindAddr} =
  292.     #    (exists($args->{BindAddr}) ?
  293.     #     delete($args->{BindAddr}) :
  294.     #     undef
  295.     #    );
  296.  
  297.     #${*$self}->{SOCKS}->{BindPort} =
  298.     #    (exists($args->{BindPort}) ?
  299.     #     delete($args->{BindPort}) :
  300.     #     undef
  301.     #    );
  302.  
  303.     ${*$self}->{SOCKS}->{AuthType} =
  304.         (exists($args->{AuthType}) ?
  305.          delete($args->{AuthType}) :
  306.          "none"
  307.         );
  308.     
  309.     ${*$self}->{SOCKS}->{RequireAuth} =
  310.         (exists($args->{RequireAuth}) ?
  311.          delete($args->{RequireAuth}) :
  312.          0
  313.         );
  314.     
  315.     ${*$self}->{SOCKS}->{UserAuth} =
  316.         (exists($args->{UserAuth}) ?
  317.          delete($args->{UserAuth}) :
  318.          undef
  319.         );
  320.     
  321.     ${*$self}->{SOCKS}->{Username} =
  322.         (exists($args->{Username}) ?
  323.          delete($args->{Username}) :
  324.          ((${*$self}->{SOCKS}->{AuthType} eq "none") ?
  325.            undef :
  326.            croak("If you set AuthType to userpass, then you must provide a username.")
  327.          )
  328.         );
  329.     
  330.     ${*$self}->{SOCKS}->{Password} =
  331.         (exists($args->{Password}) ?
  332.          delete($args->{Password}) :
  333.          ((${*$self}->{SOCKS}->{AuthType} eq "none") ?
  334.            undef :
  335.            croak("If you set AuthType to userpass, then you must provide a password.")
  336.          )
  337.         );
  338.     
  339.     ${*$self}->{SOCKS}->{Debug} =
  340.         (exists($args->{SocksDebug}) ?
  341.          delete($args->{SocksDebug}) :
  342.          0
  343.         );
  344.     
  345.     ${*$self}->{SOCKS}->{AuthMethods} = [0,0,0];
  346.     ${*$self}->{SOCKS}->{AuthMethods}->[AUTHMECH_ANON] = 1
  347.         unless ${*$self}->{SOCKS}->{RequireAuth};
  348.     #${*$self}->{SOCKS}->{AuthMethods}->[AUTHMECH_GSSAPI] = 1
  349.     #    if (${*$self}->{SOCKS}->{AuthType} eq "gssapi");
  350.     ${*$self}->{SOCKS}->{AuthMethods}->[AUTHMECH_USERPASS] = 1
  351.         if ((!exists($args->{Listen}) &&
  352.             (${*$self}->{SOCKS}->{AuthType} eq "userpass")) ||
  353.             (exists($args->{Listen}) &&
  354.             defined(${*$self}->{SOCKS}->{UserAuth})));
  355.     
  356.     ${*$self}->{SOCKS}->{COMMAND} = undef;
  357.  
  358.     if (exists($args->{Listen}))
  359.     {
  360.         $args->{LocalAddr} = ${*$self}->{SOCKS}->{ProxyAddr};
  361.         $args->{LocalPort} = ${*$self}->{SOCKS}->{ProxyPort};
  362.         $args->{Reuse} = 1;
  363.     }
  364.     else
  365.     {
  366.         $args->{PeerAddr} = ${*$self}->{SOCKS}->{ProxyAddr};
  367.         $args->{PeerPort} = ${*$self}->{SOCKS}->{ProxyPort};
  368.     }
  369.  
  370.     $args->{Proto} = "tcp";
  371.     $args->{Type} = SOCK_STREAM;
  372.  
  373.     my $status = $self->SUPER::configure($args);
  374.     return unless $status;
  375.  
  376.     #--------------------------------------------------------------------------
  377.     # We are configured... Return the object.
  378.     #--------------------------------------------------------------------------
  379.     return $status;
  380. }
  381.  
  382.  
  383.  
  384.  
  385. ###############################################################################
  386. #+-----------------------------------------------------------------------------
  387. #| Connect Functions
  388. #+-----------------------------------------------------------------------------
  389. ###############################################################################
  390.  
  391. ###############################################################################
  392. #
  393. # connect - On a configure, connect is called to open the connection.  When
  394. #           we do this we have to talk to the SOCKS5 proxy, log in, and
  395. #           connect to the remote host.
  396. #
  397. ###############################################################################
  398. sub connect
  399. {
  400.     my $self = shift;
  401.  
  402.     croak("Undefined IO::Socket::Socks object passed to connect.")
  403.         unless defined($self);
  404.  
  405.     #--------------------------------------------------------------------------
  406.     # Establish a connection
  407.     #--------------------------------------------------------------------------
  408.     $self = $self->SUPER::connect(@_);
  409.  
  410.     if (!$self)
  411.     {
  412.         $SOCKS_ERROR = "Connection to proxy failed.";
  413.         return;
  414.     }
  415.  
  416.     #--------------------------------------------------------------------------
  417.     # Handle any authentication
  418.     #--------------------------------------------------------------------------
  419.     my $auth_mech = $self->_socks5_connect();
  420.     return unless defined $auth_mech;
  421.  
  422.     if ($auth_mech != AUTHMECH_ANON)
  423.     {
  424.         return unless $self->_socks5_connect_auth();
  425.     }
  426.     
  427.     #--------------------------------------------------------------------------
  428.     # Send the command (CONNECT/BIND/UDP)
  429.     #--------------------------------------------------------------------------
  430.     if (defined(${*$self}->{SOCKS}->{ConnectAddr}) &&
  431.         defined(${*$self}->{SOCKS}->{ConnectPort}))
  432.     {
  433.         return unless $self->_socks5_connect_command(CMD_CONNECT);
  434.  
  435.         #if (defined(${*$self}->{SOCKS}->{BindPort}))
  436.         #{
  437.         #    ${*$self}->{SOCKS}->{BindAddr} = ${*$self}->{SOCKS}->{ProxyAddr}
  438.         #        unless defined(${*$self}->{SOCKS}->{BindAddr});
  439.         #    return unless $self->_socks5_connect_command(CMD_BIND);
  440.         #}
  441.     }
  442.  
  443.     return $self;
  444. }
  445.  
  446.  
  447. ###############################################################################
  448. #
  449. # _socks5_connect - Send the opening handsake, and process the reply.
  450. #
  451. ###############################################################################
  452. sub _socks5_connect
  453. {
  454.     my $self = shift;
  455.  
  456.     #--------------------------------------------------------------------------
  457.     # Send the auth mechanisms
  458.     #--------------------------------------------------------------------------
  459.     my %connect;
  460.     $connect{version} = SOCKS5_VER;
  461.     my @methods;
  462.     foreach my $method (0..$#{${*$self}->{SOCKS}->{AuthMethods}})
  463.     {
  464.         push(@methods,$method)
  465.             if (${*$self}->{SOCKS}->{AuthMethods}->[$method] == 1);
  466.     }
  467.     $connect{num_methods} = $#methods + 1;
  468.     $connect{methods} = \@methods;
  469.     
  470.     $self->_debug_connect("Send",\%connect);
  471.  
  472.     $self->_socks_send($connect{version});
  473.     $self->_socks_send($connect{num_methods});
  474.     foreach my $method (@{$connect{methods}})
  475.     {
  476.         $self->_socks_send($method);
  477.     }
  478.  
  479.     #--------------------------------------------------------------------------
  480.     # Read the reply
  481.     #--------------------------------------------------------------------------
  482.     my %connect_reply;
  483.     $connect_reply{version} = $self->_socks_read();
  484.     $connect_reply{auth_method} = $self->_socks_read();
  485.  
  486.     $self->_debug_connect_reply("Recv",\%connect_reply);
  487.     
  488.     if ($connect_reply{auth_method} == AUTHMECH_INVALID)
  489.     {
  490.         $SOCKS_ERROR = $CODES{AUTHMECH}->[$connect_reply{auth_method}];
  491.         return;
  492.     }
  493.  
  494.     return $connect_reply{auth_method};
  495. }
  496.  
  497.  
  498. ###############################################################################
  499. #
  500. # _socks5_connect_auth - Send and receive a SOCKS5 auth handshake
  501. #
  502. ###############################################################################
  503. sub _socks5_connect_auth
  504. {
  505.     my $self = shift;
  506.     
  507.     #--------------------------------------------------------------------------
  508.     # Send the auth
  509.     #--------------------------------------------------------------------------
  510.     my %auth;
  511.     $auth{version} = 1;
  512.     $auth{user_length} = length(${*$self}->{SOCKS}->{Username});
  513.     $auth{user} = ${*$self}->{SOCKS}->{Username};
  514.     $auth{pass_length} = length(${*$self}->{SOCKS}->{Password});
  515.     $auth{pass} = ${*$self}->{SOCKS}->{Password};
  516.     
  517.     $self->_debug_auth("Send",\%auth);
  518.         
  519.     $self->_socks_send($auth{version});
  520.     $self->_socks_send($auth{user_length});
  521.     $self->_socks_send_raw($auth{user});
  522.     $self->_socks_send($auth{pass_length});
  523.     $self->_socks_send_raw($auth{pass});
  524.     
  525.     #--------------------------------------------------------------------------
  526.     # Read the reply
  527.     #--------------------------------------------------------------------------
  528.     my %auth_reply;
  529.     $auth_reply{version} = $self->_socks_read();
  530.     $auth_reply{status} = $self->_socks_read();
  531.     
  532.     $self->_debug_auth_reply("Recv",\%auth_reply);
  533.         
  534.     if ($auth_reply{status} != AUTHREPLY_SUCCESS)
  535.     {
  536.         $SOCKS_ERROR = "Authentication failed with SOCKS5 proxy.";
  537.         return;
  538.     }
  539.  
  540.     return 1;
  541. }
  542.  
  543.  
  544. ###############################################################################
  545. #
  546. # _socks_connect_command - Process a SOCKS5 command request
  547. #
  548. ###############################################################################
  549. sub _socks5_connect_command
  550. {
  551.     my $self = shift;
  552.     my $command = shift;
  553.  
  554.     #--------------------------------------------------------------------------
  555.     # Send the command
  556.     #--------------------------------------------------------------------------
  557.     my %command;
  558.     $command{version} = SOCKS5_VER;
  559.     $command{command} = $command;
  560.     $command{reserved} = 0;
  561.     $command{atype} = ADDR_DOMAINNAME;
  562.     $command{host_length} = length(${*$self}->{SOCKS}->{ConnectAddr});
  563.     $command{host} = ${*$self}->{SOCKS}->{ConnectAddr};
  564.     $command{port} = ${*$self}->{SOCKS}->{ConnectPort};
  565.  
  566.     $self->_debug_command("Send",\%command);
  567.         
  568.     $self->_socks_send($command{version});
  569.     $self->_socks_send($command{command});
  570.     $self->_socks_send($command{reserved});
  571.     $self->_socks_send($command{atype});
  572.     $self->_socks_send($command{host_length});
  573.     $self->_socks_send_raw($command{host});
  574.     $self->_socks_send_raw(pack("n",$command{port}));
  575.  
  576.     #--------------------------------------------------------------------------
  577.     # Read the reply
  578.     #--------------------------------------------------------------------------
  579.     my %command_reply;
  580.     $command_reply{version} = $self->_socks_read();
  581.     $command_reply{status} = $self->_socks_read();
  582.     
  583.     if ($command_reply{status} == REPLY_SUCCESS)
  584.     {
  585.         $command_reply{reserved} = $self->_socks_read();
  586.         $command_reply{atype} = $self->_socks_read();
  587.  
  588.         if ($command_reply{atype} == ADDR_DOMAINNAME)
  589.         {
  590.             $command_reply{host_length} = $self->_socks_read();
  591.             $command_reply{host} = $self->_socks_read_raw($command_reply{host_length});
  592.         }
  593.         elsif ($command_reply{atype} == ADDR_IPV4)
  594.         {
  595.             $command_reply{host} = unpack("N",$self->_socks_read_raw(4));
  596.         }
  597.         
  598.         $command_reply{port} = unpack("n",$self->_socks_read_raw(2));
  599.     }
  600.     
  601.     $self->_debug_command_reply("Recv",\%command_reply);
  602.         
  603.     if ($command_reply{status} != REPLY_SUCCESS)
  604.     {
  605.         $SOCKS_ERROR = $CODES{REPLY}->[$command_reply{status}];
  606.         return;
  607.     }
  608.  
  609.     return 1;
  610. }
  611.     
  612.  
  613.  
  614.  
  615. ###############################################################################
  616. #+-----------------------------------------------------------------------------
  617. #| Accept Functions
  618. #+-----------------------------------------------------------------------------
  619. ###############################################################################
  620.  
  621. ###############################################################################
  622. #
  623. # accept - When we are accepting new connections, we need to do the SOCKS
  624. #          handshaking before we return a usable socket.
  625. #
  626. ###############################################################################
  627. sub accept
  628. {
  629.     my $self = shift;
  630.  
  631.     croak("Undefined IO::Socket::Socks object passed to accept.")
  632.         unless defined($self);
  633.  
  634.     my $client = $self->SUPER::accept(@_);
  635.  
  636.     if (!$self)
  637.     {
  638.         $SOCKS_ERROR = "Proxy accept new client failed.";
  639.         return;
  640.     }
  641.  
  642.     my $authmech = $self->_socks5_accept($client);
  643.     return unless defined($authmech);
  644.  
  645.     if ($authmech == AUTHMECH_USERPASS)
  646.     {
  647.         return unless $self->_socks5_accept_auth($client);
  648.     }
  649.  
  650.     return unless $self->_socks5_accept_command($client);
  651.  
  652.     return $client;
  653. }
  654.  
  655.  
  656. ###############################################################################
  657. #
  658. # _socks5_accept - Wait for an opening handsake, and reply.
  659. #
  660. ###############################################################################
  661. sub _socks5_accept
  662. {
  663.     my $self = shift;
  664.     my $client = shift;
  665.  
  666.     #--------------------------------------------------------------------------
  667.     # Read the auth mechanisms
  668.     #--------------------------------------------------------------------------
  669.     my %accept;
  670.     $accept{version} = $client->_socks_read();
  671.     $accept{num_methods} = $client->_socks_read();
  672.     $accept{methods} = [];
  673.     foreach (0..($accept{num_methods}-1))
  674.     {
  675.         push(@{$accept{methods}},$client->_socks_read());
  676.     }
  677.     
  678.     $self->_debug_connect("Recv",\%accept);
  679.  
  680.     if ($accept{num_methods} == 0)
  681.     {
  682.         $SOCKS_ERROR = "No auth methods sent.";
  683.         return;
  684.     }
  685.  
  686.     my $authmech;
  687.     
  688.     foreach my $method (@{$accept{methods}})
  689.     {
  690.         if (${*$self}->{SOCKS}->{AuthMethods}->[$method] == 1)
  691.         {
  692.             $authmech = $method;
  693.             last;
  694.         }
  695.     }
  696.  
  697.     if (!defined($authmech))
  698.     {
  699.         $authmech = AUTHMECH_INVALID;
  700.     }
  701.  
  702.     #--------------------------------------------------------------------------
  703.     # Send the reply
  704.     #--------------------------------------------------------------------------
  705.     my %accept_reply;
  706.     $accept_reply{version} = SOCKS5_VER;
  707.     $accept_reply{auth_method} = AUTHMECH_INVALID;
  708.     $accept_reply{auth_method} = $authmech if defined($authmech);
  709.  
  710.     $client->_socks_send($accept_reply{version});
  711.     $client->_socks_send($accept_reply{auth_method});
  712.     
  713.     $self->_debug_connect_reply("Send",\%accept_reply);
  714.  
  715.     if ($authmech == AUTHMECH_INVALID)
  716.     {
  717.         $SOCKS_ERROR = "No available auth methods.";
  718.         return;
  719.     }
  720.     
  721.     return $authmech;
  722. }
  723.  
  724.  
  725. ###############################################################################
  726. #
  727. # _socks5_accept_auth - Send and receive a SOCKS5 auth handshake
  728. #
  729. ###############################################################################
  730. sub _socks5_accept_auth
  731. {
  732.     my $self = shift;
  733.     my $client = shift;
  734.     
  735.     #--------------------------------------------------------------------------
  736.     # Send the auth
  737.     #--------------------------------------------------------------------------
  738.     my %auth;
  739.     $auth{version} = $client->_socks_read();
  740.     $auth{user_length} = $client->_socks_read();
  741.     $auth{user} = $client->_socks_read_raw($auth{user_length});
  742.     $auth{pass_length} = $client->_socks_read();
  743.     $auth{pass} = $client->_socks_read_raw($auth{pass_length});
  744.     
  745.     $self->_debug_auth("Recv",\%auth);
  746.     
  747.     my $status = 0;
  748.     if (defined(${*$self}->{SOCKS}->{UserAuth}))
  749.     {
  750.         $status = &{${*$self}->{SOCKS}->{UserAuth}}($auth{user},$auth{pass});
  751.     }
  752.  
  753.     #--------------------------------------------------------------------------
  754.     # Read the reply
  755.     #--------------------------------------------------------------------------
  756.     my %auth_reply;
  757.     $auth_reply{version} = 1;
  758.     $auth_reply{status} = AUTHREPLY_SUCCESS;
  759.     $auth_reply{status} = AUTHREPLY_FAILURE if !$status;
  760.     
  761.     $client->_socks_send($auth_reply{version});
  762.     $client->_socks_send($auth_reply{status});
  763.     
  764.     $self->_debug_auth_reply("Send",\%auth_reply);
  765.         
  766.     if ($auth_reply{status} != AUTHREPLY_SUCCESS)
  767.     {
  768.         $SOCKS_ERROR = "Authentication failed with SOCKS5 proxy.";
  769.         return;
  770.     }
  771.  
  772.     return 1;
  773. }
  774.  
  775.  
  776. ###############################################################################
  777. #
  778. # _socks5_acccept_command - Process a SOCKS5 command request.  Since this is
  779. #                           a library and not a server, we cannot process the
  780. #                           command.  Let the parent program handle that.
  781. #
  782. ###############################################################################
  783. sub _socks5_accept_command
  784. {
  785.     my $self = shift;
  786.     my $client = shift;
  787.  
  788.     #--------------------------------------------------------------------------
  789.     # Read the command
  790.     #--------------------------------------------------------------------------
  791.     my %command;
  792.     $command{version} = $client->_socks_read();
  793.     $command{command} = $client->_socks_read();
  794.     $command{reserved} = $client->_socks_read();
  795.     $command{atype} = $client->_socks_read();
  796.  
  797.     if ($command{atype} == ADDR_DOMAINNAME)
  798.     {
  799.         $command{host_length} =  $client->_socks_read();
  800.         $command{host} = $client->_socks_read_raw($command{host_length});
  801.     }
  802.     elsif ($command{atype} == ADDR_IPV4)
  803.     {
  804.         $command{host} = unpack("N",$client->_socks_read_raw(4));
  805.     }
  806.     else
  807.     {
  808.         $client->_socks_accept_command_reply(REPLY_ADDR_NOT_SUPPORTED);
  809.         $SOCKS_ERROR = $CODES{REPLY}->[REPLY_ADDR_NOT_SUPPORTED];
  810.         return;
  811.     }
  812.     
  813.     $command{port} = unpack("n",$client->_socks_read_raw(2));
  814.  
  815.     $self->_debug_command("Recv",\%command);
  816.  
  817.     ${*$client}->{SOCKS}->{COMMAND} = [$command{command},$command{host},$command{port}];
  818.  
  819.     return 1;
  820. }
  821.  
  822.  
  823. ###############################################################################
  824. #
  825. # _socks5_acccept_command_reply - Answer a SOCKS5 command request.  Since this
  826. #                                 is a library and not a server, we cannot
  827. #                                 process the command.  Let the parent program
  828. #                                 handle that.
  829. #
  830. ###############################################################################
  831. sub _socks5_accept_command_reply
  832. {
  833.     my $self = shift;
  834.     my $reply = shift;
  835.     my $host = shift;
  836.     my $port = shift;
  837.  
  838.     if (!defined($reply) || !defined($host) || !defined($port))
  839.     {
  840.         croak("You must provide a reply, host, and port on the command reply.");
  841.     }
  842.  
  843.     #--------------------------------------------------------------------------
  844.     # Send the reply
  845.     #--------------------------------------------------------------------------
  846.     my %command_reply;
  847.     $command_reply{version} = SOCKS5_VER;
  848.     $command_reply{status} = $reply;
  849.     $command_reply{reserved} = 0;
  850.     $command_reply{atype} = ADDR_DOMAINNAME;
  851.     $command_reply{host_length} = length($host);
  852.     $command_reply{host} = $host;
  853.     $command_reply{port} = $port;
  854.     
  855.     $self->_debug_command_reply("Send",\%command_reply);
  856.  
  857.     $self->_socks_send($command_reply{version});
  858.     $self->_socks_send($command_reply{status});
  859.     $self->_socks_send($command_reply{reserved});
  860.     $self->_socks_send($command_reply{atype});
  861.     $self->_socks_send($command_reply{host_length});
  862.     $self->_socks_send_raw($command_reply{host});
  863.     $self->_socks_send_raw(pack("n",$command_reply{port}));
  864. }
  865.  
  866.  
  867. ###############################################################################
  868. #
  869. # command - return the command the user request along with the host and
  870. #           port to operate on.
  871. #
  872. ###############################################################################
  873. sub command
  874. {
  875.     my $self = shift;
  876.  
  877.     return ${*$self}->{SOCKS}->{COMMAND};
  878. }
  879.  
  880.  
  881. ###############################################################################
  882. #
  883. # command_reply - public reply wrapper to the client.
  884. #
  885. ###############################################################################
  886. sub command_reply
  887. {
  888.     my $self = shift;
  889.     $self->_socks5_accept_command_reply(@_);
  890. }
  891.  
  892.  
  893.  
  894.  
  895.  
  896. ###############################################################################
  897. #+-----------------------------------------------------------------------------
  898. #| Helper Functions
  899. #+-----------------------------------------------------------------------------
  900. ###############################################################################
  901.  
  902. ###############################################################################
  903. #
  904. # _socks_read - send over the socket after packing according to the rules.
  905. #
  906. ###############################################################################
  907. sub _socks_send
  908. {
  909.     my $self = shift;
  910.     my $data = shift;
  911.     
  912.     $data = pack("C",$data);
  913.     $self->_socks_send_raw($data);
  914. } 
  915.  
  916.  
  917. ###############################################################################
  918. #
  919. # _socks_send_raw - send raw data across the socket.
  920. #
  921. ###############################################################################
  922. sub _socks_send_raw
  923. {
  924.     my $self = shift;
  925.     my $data = shift;
  926.  
  927.     $self->syswrite($data,length($data));
  928. }
  929.  
  930.  
  931. ###############################################################################
  932. #
  933. # _socks_read - read from the socket, and then unpack according to the rules.
  934. #
  935. ###############################################################################
  936. sub _socks_read
  937. {
  938.     my $self = shift;
  939.     my $length = shift;
  940.     $length = 1 unless defined($length);
  941.     
  942.     my $data = $self->_socks_read_raw($length);
  943.     $data = unpack("C",$data);
  944.     return $data;
  945. }
  946.  
  947.  
  948. ###############################################################################
  949. #
  950. # _socks_read_raw - read raw bytes off of the socket
  951. #
  952. ###############################################################################
  953. sub _socks_read_raw
  954. {
  955.     my $self = shift;
  956.     my $length = shift;
  957.     $length = 1 unless defined($length);
  958.  
  959.     my $data;
  960.     $self->sysread($data,$length);
  961.     return $data;
  962. }
  963.  
  964.  
  965.  
  966.  
  967. ###############################################################################
  968. #+-----------------------------------------------------------------------------
  969. #| Debug Functions
  970. #+-----------------------------------------------------------------------------
  971. ###############################################################################
  972.  
  973. sub _debug_connect
  974. {
  975.     my $self = shift;
  976.     my $tag = shift;
  977.     my $connect = shift;
  978.  
  979.     return unless ${*$self}->{SOCKS}->{Debug};
  980.  
  981.     print "$tag: +------+------+-","-"x(4*$connect->{num_methods}),"-+\n";
  982.     print "$tag: | Vers | Auth |";
  983.     if ($connect->{num_methods} > 0)
  984.     {
  985.         print " Meth "," "x(4*($connect->{num_methods}-1)),"|\n";
  986.     }
  987.     print "$tag: +------+------+-","-"x(4*$connect->{num_methods}),"-+\n";
  988.  
  989.     print "$tag: | ";
  990.     printf("\\%02X",$connect->{version});
  991.     print "  | ";
  992.     printf("\\%02X",$connect->{num_methods});
  993.     print "  | ";
  994.     if ($connect->{num_methods} > 0)
  995.     {
  996.         foreach my $method (@{$connect->{methods}})
  997.         {
  998.             printf("\\%02X ",$method);
  999.         }
  1000.         print " |";
  1001.     }
  1002.     
  1003.     print "\n";
  1004.     print "$tag: +------+------+-","-"x(4*$connect->{num_methods}),"-+\n";
  1005.     print "\n";
  1006. }
  1007.  
  1008.  
  1009. sub _debug_connect_reply
  1010. {
  1011.     my $self = shift;
  1012.     my $tag = shift;
  1013.     my $connect_reply = shift;
  1014.     
  1015.     return unless ${*$self}->{SOCKS}->{Debug};
  1016.  
  1017.     print "$tag: +------+------+\n";
  1018.     print "$tag: | Vers | Auth |\n";
  1019.     print "$tag: +------+------+\n";
  1020.     print "$tag: | ";
  1021.     
  1022.     printf("\\%02X",$connect_reply->{version});
  1023.     print "  | ";
  1024.     printf("\\%02X",$connect_reply->{auth_method});
  1025.     print "  |\n";
  1026.  
  1027.     print "$tag: +------+------+\n";
  1028.     print "\n";
  1029. }
  1030.  
  1031.  
  1032. sub _debug_auth
  1033. {
  1034.     my $self = shift;
  1035.     my $tag = shift;
  1036.     my $auth = shift;
  1037.  
  1038.     return unless ${*$self}->{SOCKS}->{Debug};
  1039.  
  1040.     print "$tag: +------+------+------","-"x($auth->{user_length}-4),"+------+-----","-"x($auth->{pass_length}-4),"-+\n";
  1041.     print "$tag: | Vers | UsrL | User "," "x($auth->{user_length}-4),"| PasL | Pass"," "x($auth->{pass_length}-4)," |\n";
  1042.     print "$tag: +------+------+------","-"x($auth->{user_length}-4),"+------+-----","-"x($auth->{pass_length}-4),"-+\n";
  1043.     print "$tag: | ";
  1044.  
  1045.     printf("\\%02X",$auth->{version});
  1046.     print "  | ";
  1047.     printf("\\%02d",$auth->{user_length});
  1048.     print "  | ";
  1049.     print $auth->{user}," "x(4-$auth->{user_length});
  1050.     print " | ";
  1051.     printf("\\%02d",$auth->{pass_length});
  1052.     print "  | ";
  1053.     print $auth->{pass}," "x(4-$auth->{pass_length});
  1054.  
  1055.     print " |\n";
  1056.     print "$tag: +------+------+------","-"x($auth->{user_length}-4),"+------+-----","-"x($auth->{pass_length}-4),"-+\n";
  1057.     print "\n";
  1058. }  
  1059.  
  1060.  
  1061. sub _debug_auth_reply
  1062. {
  1063.     my $self = shift;
  1064.     my $tag = shift;
  1065.     my $auth_reply = shift;
  1066.     
  1067.     return unless ${*$self}->{SOCKS}->{Debug};
  1068.  
  1069.     print "$tag: +------+------+\n";
  1070.     print "$tag: | Vers | Stat |\n";
  1071.     print "$tag: +------+------+\n";
  1072.     print "$tag: | ";
  1073.     
  1074.     printf("\\%02X",$auth_reply->{version});
  1075.     print "  | ";
  1076.     printf("\\%02X",$auth_reply->{status});
  1077.     print "  |\n";
  1078.  
  1079.     print "$tag: +------+------+\n";
  1080.     print "\n";
  1081. }
  1082.  
  1083.  
  1084. sub _debug_command
  1085. {
  1086.     my $self = shift;
  1087.     my $tag = shift;
  1088.     my $command = shift;
  1089.  
  1090.     return unless ${*$self}->{SOCKS}->{Debug};
  1091.  
  1092.     print "$tag: +------+------+------+------+-------","-"x$command->{host_length},"-+-------+\n";
  1093.     print "$tag: | Vers | Comm | Resv | ATyp | Host  "," "x$command->{host_length}," | Port  |\n";
  1094.     print "$tag: +------+------+------+------+-------","-"x$command->{host_length},"-+-------+\n";
  1095.     print "$tag: | "; 
  1096.  
  1097.     printf("\\%02X",$command->{version});
  1098.     print "  | ";
  1099.     printf("\\%02X",$command->{command});
  1100.     print "  | ";
  1101.     printf("\\%02X",$command->{reserved});
  1102.     print "  | ";
  1103.     printf("\\%02X",$command->{atype});
  1104.     print "  | ";
  1105.     printf("\\%02d",$command->{host_length});
  1106.     print " - ";
  1107.     print $command->{host};
  1108.     print " | ";
  1109.     printf("%-5d",$command->{port});
  1110.  
  1111.     print " |\n";
  1112.     print "$tag: +------+------+------+------+-------","-"x$command->{host_length},"-+-------+\n";
  1113.     print "\n";
  1114. }
  1115.  
  1116.  
  1117. sub _debug_command_reply
  1118. {
  1119.     my $self = shift;
  1120.     my $tag = shift;
  1121.     my $command_reply = shift;
  1122.  
  1123.     return unless ${*$self}->{SOCKS}->{Debug};
  1124.  
  1125.     print "$tag: +------+------+";
  1126.     print "------+------+-------","-"x$command_reply->{host_length},"-+-------+"
  1127.         if ($command_reply->{status} == 0);
  1128.     print "\n";
  1129.  
  1130.     print "$tag: | Vers | Stat |";
  1131.     print " Resv | ATyp | Host  "," "x$command_reply->{host_length}," | Port  |"
  1132.         if ($command_reply->{status} == 0);
  1133.     print "\n";
  1134.  
  1135.     print "$tag: +------+------+";
  1136.     print "------+------+-------","-"x$command_reply->{host_length},"-+-------+"
  1137.         if ($command_reply->{status} == 0);
  1138.     print "\n";
  1139.     
  1140.     print "$tag: | "; 
  1141.  
  1142.     printf("\\%02X",$command_reply->{version});
  1143.     print "  | ";
  1144.     printf("\\%02X",$command_reply->{status});
  1145.     if ($command_reply->{status} == 0)
  1146.     {
  1147.         print "  | ";
  1148.         printf("\\%02X",$command_reply->{reserved});
  1149.         print "  | ";
  1150.         printf("\\%02X",$command_reply->{atype});
  1151.         print "  | ";
  1152.         printf("\\%02d",$command_reply->{host_length});
  1153.         print " - ";
  1154.         print $command_reply->{host};
  1155.         print " | ";
  1156.         printf("%-5d",$command_reply->{port});
  1157.     }
  1158.     else
  1159.     {
  1160.         print " ";
  1161.     }
  1162.     print " |\n";
  1163.     
  1164.     print "$tag: +------+------+";
  1165.     print "------+------+-------","-"x$command_reply->{host_length},"-+-------+"
  1166.         if ($command_reply->{status} == 0);
  1167.     print "\n";
  1168.     print "\n";
  1169. }
  1170.  
  1171.  
  1172. 1;
  1173.